home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH5 / SRC / BOUNCE1.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-05-02  |  7.0 KB  |  226 lines
  1. VERSION 4.00
  2. Begin VB.Form BounceForm 
  3.    Caption         =   "Bounce1"
  4.    ClientHeight    =   5235
  5.    ClientLeft      =   1320
  6.    ClientTop       =   1110
  7.    ClientWidth     =   6870
  8.    Height          =   5925
  9.    Left            =   1260
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   349
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   458
  14.    Top             =   480
  15.    Width           =   6990
  16.    Begin VB.TextBox FPSText 
  17.       Height          =   285
  18.       Left            =   1440
  19.       TabIndex        =   4
  20.       Text            =   "20"
  21.       Top             =   4920
  22.       Width           =   375
  23.    End
  24.    Begin VB.TextBox BallsText 
  25.       Height          =   285
  26.       Left            =   1440
  27.       TabIndex        =   3
  28.       Text            =   "20"
  29.       Top             =   4560
  30.       Width           =   375
  31.    End
  32.    Begin VB.CommandButton CmdStart 
  33.       Caption         =   "Start"
  34.       Default         =   -1  'True
  35.       Height          =   495
  36.       Left            =   2160
  37.       TabIndex        =   1
  38.       Top             =   4620
  39.       Width           =   855
  40.    End
  41.    Begin VB.PictureBox Court 
  42.       AutoRedraw      =   -1  'True
  43.       Height          =   4455
  44.       Left            =   0
  45.       ScaleHeight     =   293
  46.       ScaleMode       =   3  'Pixel
  47.       ScaleWidth      =   453
  48.       TabIndex        =   0
  49.       Top             =   0
  50.       Width           =   6855
  51.    End
  52.    Begin VB.Label Label1 
  53.       Caption         =   "Frames per second:"
  54.       Height          =   255
  55.       Index           =   0
  56.       Left            =   0
  57.       TabIndex        =   5
  58.       Top             =   4920
  59.       Width           =   1455
  60.    End
  61.    Begin VB.Label Label1 
  62.       Caption         =   "Number of balls:"
  63.       Height          =   255
  64.       Index           =   1
  65.       Left            =   0
  66.       TabIndex        =   2
  67.       Top             =   4560
  68.       Width           =   1455
  69.    End
  70.    Begin VB.Menu mnuFile 
  71.       Caption         =   "&File"
  72.       Begin VB.Menu mnuFileExit 
  73.          Caption         =   "E&xit"
  74.       End
  75.    End
  76. Attribute VB_Name = "BounceForm"
  77. Attribute VB_Creatable = False
  78. Attribute VB_Exposed = False
  79. Option Explicit
  80. Dim xmax As Integer
  81. Dim ymax As Integer
  82. Dim NumBalls As Integer
  83. Dim BallR() As Integer
  84. Dim BallX() As Integer
  85. Dim BallY() As Integer
  86. Dim BallDx() As Integer
  87. Dim BallDy() As Integer
  88. Dim BallClr() As Long
  89. Dim Playing As Boolean
  90. ' ************************************************
  91. ' Generate some random data.
  92. ' ************************************************
  93. Sub InitData()
  94. Dim ball As Integer
  95. Dim R As Integer
  96. Dim clr As Integer
  97.     ' See how many balls there should be.
  98.     If Not IsNumeric(BallsText.Text) Then _
  99.         BallsText.Text = "10"
  100.     NumBalls = CInt(BallsText.Text)
  101.     ReDim BallR(1 To NumBalls)
  102.     ReDim BallX(1 To NumBalls)
  103.     ReDim BallY(1 To NumBalls)
  104.     ReDim BallDx(1 To NumBalls)
  105.     ReDim BallDy(1 To NumBalls)
  106.     ReDim BallClr(1 To NumBalls)
  107.     ' Set the initial ball data.
  108.     For ball = 1 To NumBalls
  109.         R = Int(10 * Rnd + 5)
  110.         BallR(ball) = R
  111.         BallX(ball) = Int((xmax - R + 1) * Rnd)
  112.         BallY(ball) = Int((ymax - R + 1) * Rnd)
  113.         BallDx(ball) = Int(21 * Rnd - 10)
  114.         BallDy(ball) = Int(21 * Rnd - 10)
  115.         clr = Int(15 * Rnd)
  116.         If clr >= 7 Then clr = clr + 1
  117.         BallClr(ball) = QBColor(clr)
  118.     Next ball
  119. End Sub
  120. ' ************************************************
  121. ' Start the animation.
  122. ' ************************************************
  123. Private Sub CmdStart_Click()
  124.     If Playing Then
  125.         Playing = False
  126.         CmdStart.Caption = "Stopped"
  127.         CmdStart.Enabled = False
  128.     Else
  129.         CmdStart.Caption = "Stop"
  130.         Playing = True
  131.         InitData
  132.         PlayData
  133.         Playing = False
  134.         CmdStart.Caption = "Start"
  135.         CmdStart.Enabled = True
  136.     End If
  137. End Sub
  138. ' ************************************************
  139. ' Play the animation.
  140. ' ************************************************
  141. Sub PlayData()
  142. Dim mpf As Long     ' Milliseconds per frame.
  143. Dim ball As Integer
  144. Dim next_time As Long
  145. Dim old_style As Integer
  146. Dim frames As Integer
  147. Dim start_time As Single
  148. Dim stop_time As Single
  149.     ' Set FillStyle to vbSolid.
  150.     old_style = Court.FillStyle
  151.     Court.FillStyle = vbSolid
  152.     ' See how fast we should go.
  153.     If Not IsNumeric(FPSText.Text) Then _
  154.         FPSText.Text = "10"
  155.     mpf = 1000 \ CLng(FPSText.Text)
  156.     ' Start the animation.
  157.     start_time = Timer
  158.     next_time = GetTickCount()
  159.     Do While Playing
  160.         frames = frames + 1
  161.         
  162.         ' Draw the balls.
  163.         Court.Cls
  164.         For ball = 1 To NumBalls
  165.             Court.FillColor = BallClr(ball)
  166.             Court.Circle _
  167.                 (BallX(ball), BallY(ball)), _
  168.                 BallR(ball), BallClr(ball)
  169.         Next ball
  170.             
  171.         ' Move the balls.
  172.         For ball = 1 To NumBalls
  173.             BallX(ball) = BallX(ball) + BallDx(ball)
  174.             If BallX(ball) < BallR(ball) Then
  175.                 BallX(ball) = 2 * BallR(ball) - BallX(ball)
  176.                 BallDx(ball) = -BallDx(ball)
  177.             ElseIf BallX(ball) > xmax - BallR(ball) Then
  178.                 BallX(ball) = 2 * (xmax - BallR(ball)) - BallX(ball)
  179.                 BallDx(ball) = -BallDx(ball)
  180.             End If
  181.             
  182.             BallY(ball) = BallY(ball) + BallDy(ball)
  183.             If BallY(ball) < BallR(ball) Then
  184.                 BallY(ball) = 2 * BallR(ball) - BallY(ball)
  185.                 BallDy(ball) = -BallDy(ball)
  186.             ElseIf BallY(ball) > ymax - BallR(ball) Then
  187.                 BallY(ball) = 2 * (ymax - BallR(ball)) - BallY(ball)
  188.                 BallDy(ball) = -BallDy(ball)
  189.             End If
  190.         Next ball
  191.             
  192.         ' Wait until it's time for the next frame.
  193.         next_time = next_time + mpf
  194.         WaitTill next_time
  195.     Loop
  196.     stop_time = Timer
  197.     MsgBox "Displayed" & Str$(frames) & _
  198.         " frames in " & _
  199.         Format$(stop_time - start_time, "0.00") & _
  200.         " seconds (" & _
  201.         Format$(frames / (stop_time - start_time), "0.00") & _
  202.         " FPS)."
  203.     ' Restore the old FillStyle.
  204.     Court.FillStyle = old_style
  205. End Sub
  206. ' ************************************************
  207. ' Make the ball court nice and big.
  208. ' ************************************************
  209. Private Sub Form_Resize()
  210. Const GAP = 3
  211.     FPSText.Top = ScaleHeight - GAP - FPSText.Height
  212.     Label1(0).Top = FPSText.Top
  213.     BallsText.Top = FPSText.Top - GAP - BallsText.Height
  214.     Label1(1).Top = BallsText.Top
  215.     CmdStart.Top = (BallsText.Top + FPSText.Top + FPSText.Height - CmdStart.Height) / 2
  216.     Court.Move 0, 0, ScaleWidth, BallsText.Top - GAP
  217.     xmax = Court.ScaleWidth - 1
  218.     ymax = Court.ScaleHeight - 1
  219. End Sub
  220. Private Sub Form_Unload(Cancel As Integer)
  221.     End
  222. End Sub
  223. Private Sub mnuFileExit_Click()
  224.     Unload Me
  225. End Sub
  226.